﻿
Public Class ProductionManager


    'all the production symbols, this is the unified collection of all the symbols
    Private ReadOnly m_productionSymbols As List(Of ProductionSymbol)

    'reference lists, for easier search
    Private m_nonTerminals As List(Of NonTerminal)
    Private m_terminals As List(Of Terminal)
    Private m_productions As List(Of Production)

    Friend Function GetNonTerminal(ByVal index As Integer) As NonTerminal
        Dim result = Symbols(index)
        Debug.Assert(TypeOf result Is NonTerminal)

        Return TryCast(result, NonTerminal)
    End Function

    Friend Function GetProduction(ByVal index As Integer) As Production
        Return m_productions(index)
    End Function

    Friend Function GetTerminal(ByVal index As Integer) As Terminal
        Dim result = Symbols(index)
        Debug.Assert(TypeOf result Is Terminal)

        Return TryCast(result, Terminal)
    End Function

    'Get production symbol from the index
    Default Friend ReadOnly Property Symbols(ByVal index As Integer) As ProductionSymbol
        Get
            If index >= m_productionSymbols.Count Then
                Throw New ArgumentOutOfRangeException("index")
            End If

            Return m_productionSymbols(index)
        End Get
    End Property

    Public Sub New()
        m_productionSymbols = New List(Of ProductionSymbol)(32)
        m_nonTerminals = New List(Of NonTerminal)(32)
        m_terminals = New List(Of Terminal)(32)
        m_productions = New List(Of Production)(32)

        'Add the placeholder for the root symbol
        m_productionSymbols.Add(Nothing)
    End Sub

    Public Function DefineTerminal(Optional ByVal debugName As String = Nothing) As Terminal
        Dim newIndex = m_productionSymbols.Count
        Dim newTerminal As New Terminal(newIndex)
        newTerminal.DebugName = debugName

        m_productionSymbols.Add(newTerminal)
        AddTerminals(newTerminal)

        Return newTerminal
    End Function

    Public Function DefineNonTerminal(Optional ByVal debugName As String = Nothing) As NonTerminal
        Dim newIndex = m_productionSymbols.Count
        Dim newNonTerminal As New NonTerminal(newIndex, Me)
        newNonTerminal.DebugName = debugName

        m_productionSymbols.Add(newNonTerminal)
        AddNonTerminal(newNonTerminal)

        Return newNonTerminal
    End Function

    Private m_any As Any
    Friend ReadOnly Property Any() As Any
        Get
            If m_any Is Nothing Then
                Dim newIndex = m_productionSymbols.Count
                m_any = New Any(newIndex)
                m_productionSymbols.Add(m_any)
                AddTerminals(m_any)
            End If

            Return m_any
        End Get
    End Property

    Private m_error As [Error]
    Public ReadOnly Property [Error]() As [Error]
        Get
            If m_error Is Nothing Then
                Dim newIndex = m_productionSymbols.Count
                m_error = New [Error](newIndex)
                m_productionSymbols.Add(m_error)
                AddTerminals(m_error)
            End If

            Return m_error
        End Get
    End Property

    Private m_eof As EndOfFile
    Public ReadOnly Property EndOfFile() As EndOfFile
        Get
            If m_eof Is Nothing Then
                Dim newIndex = m_productionSymbols.Count
                m_eof = New EndOfFile(newIndex)
                m_productionSymbols.Add(m_eof)
                AddTerminals(m_eof)
            End If

            Return m_eof
        End Get
    End Property

    Private Sub AddNonTerminal(ByVal nt As NonTerminal)
        m_nonTerminals.Add(nt)
    End Sub

    Friend Sub AddProduction(ByVal p As Production)
        m_productions.Add(p)
        p.Index = m_productions.Count - 1
    End Sub

    Private Sub AddTerminals(ByVal t As Terminal)
        m_terminals.Add(t)
    End Sub

    Private Sub CalculateNullableAndFirst()
        Dim firstCountChanged, nullableChanged As Boolean
        Do
            firstCountChanged = False
            nullableChanged = False

            For Each productionVar In m_nonTerminals
                For Each production In productionVar.Productions

                    'count nullable
                    If production.Sequence.All(Function(symbol) symbol.IsNullable) Then

                        Dim lastValue = productionVar.IsNullable
                        If lastValue = False Then
                            productionVar.SetNullable(True)
                            nullableChanged = True
                        End If
                    End If

                    'count first
                    Dim lastCount = productionVar.GetFirstSet().Count
                    For Each symbol In production.Sequence

                        productionVar.GetFirstSet().UnionWith(symbol.First)
                        If Not symbol.IsNullable Then Exit For
                    Next
                    If lastCount <> productionVar.GetFirstSet().Count Then
                        firstCountChanged = True
                    End If
                Next
            Next
        Loop While firstCountChanged Or nullableChanged
    End Sub

    Private Function GetClosure(ByVal initState As LR1State) As LR1State

        Contract.ArgumentNotNull(initState, "initState")

        'Closure(I) =        
        ' repeat                                
        '  for any item (A → α.Xβ, z) in I     
        '     for any production X → γ         
        '         for any w ∈ FIRST(βz)        
        '           I ← I ∪ {(X → .γ, w)}
        ' until I does not change
        ' return I                              
        Dim closure As New HashSet(Of LR1Item)(initState.Items)
        Dim lastAddedItems = closure.ToList()
        Dim newAddedItems As List(Of LR1Item)
        Dim lastClosureCount As Integer
        Do
            newAddedItems = New List(Of LR1Item)
            For Each item In lastAddedItems

                Dim itemInfo As New LR1ItemInfo(Me, item)

                If item.RightHandPosition = itemInfo.Production.Sequence.Count Then Continue For
                Dim currentProductionVar = TryCast(itemInfo.Production.Sequence(item.RightHandPosition), NonTerminal)
                If currentProductionVar Is Nothing Then Continue For

                For Each p In currentProductionVar.Productions
                    Dim after As New List(Of ProductionSymbol)
                    For i = item.RightHandPosition + 1 To itemInfo.Production.Sequence.Count - 1
                        after.Add(itemInfo.Production.Sequence(i))
                    Next

                    'count FIRST(after + item.LookAhead)
                    after.Add(itemInfo.LookAhead)
                    Dim first As New HashSet(Of Terminal)

                    For Each symbol In after
                        first.UnionWith(symbol.First)
                        If Not symbol.IsNullable Then Exit For
                    Next

                    For Each t In first
                        newAddedItems.Add(New LR1Item(p.Index, 0, t.Index))
                    Next

                Next 'For Each p In currentProductionVar.Productions
            Next 'For Each item In lastClosure

            lastClosureCount = closure.Count
            closure.UnionWith(newAddedItems)
            lastAddedItems = newAddedItems
        Loop While lastClosureCount <> closure.Count

        Return New LR1State(closure)
    End Function

    Private Function GotoSymbol(ByVal initState As LR1State, ByVal s As ProductionSymbol) As LR1State

        Contract.ArgumentNotNull(initState, "initState")

        'Goto(I, X) =
        '    set J to the empty set
        '    for any item A → α:Xβ in I
        '        add A → αX.β to J
        '    return Closure(J)
        Dim result As New HashSet(Of LR1Item)
        For Each item In initState.Items
            'get the "dot" position symbol

            Dim itemInfo As New LR1ItemInfo(Me, item)

            If itemInfo.IsPassed Then Continue For
            Dim current = itemInfo.GetCurrentSymbol()
            If current.Equals(s) Then
                'move one step next
                result.Add(New LR1Item(itemInfo.Production.Index, item.RightHandPosition + 1, itemInfo.LookAhead.Index))
            End If
        Next

        Return GetClosure(New LR1State(result))
    End Function

    Private Function CreateState(ByVal ParamArray items As LR1Item()) As LR1State
        Return GetClosure(New LR1State(items))
    End Function

    Private m_transitionTable As LR1TransitionTable

    Public ReadOnly Property TransitionTable() As LR1TransitionTable
        Get
            Return m_transitionTable
        End Get
    End Property

    Private m_rootSymbol As NonTerminal 'S
    Private m_rootSymbolWithEof As NonTerminal 'S'

    Public Sub SetRootSymbol(ByVal root As NonTerminal)
        Contract.ArgumentNotNull(root, "root")
        Contract.AssertArgumentInRange(m_nonTerminals.Contains(root), "root", _
                                       "The root production symbol must be one in the nonterminal list.")
        m_rootSymbol = root
    End Sub

    Private Sub CalculateStatesAndTransitions()
        'Initialize T to {Closure({S′ → :S$})}
        'Initialize E to empty.
        'repeat
        '      for each state I in T
        '          for each item A → α.Xβ in I
        '             let J be Goto(I, X)
        '             T ← T ∪ {J}
        '             E ← E ∪ {I *** J}
        'until E and T did not change in this iteration


        If m_rootSymbol Is Nothing Then
            Exit Sub
        End If


        m_rootSymbolWithEof = New NonTerminal(0, Me)
        'take the place holder. so the code can find this root easily
        m_productionSymbols(0) = m_rootSymbolWithEof


        m_rootSymbolWithEof.Produces(m_rootSymbol, EndOfFile)
        AddNonTerminal(m_rootSymbolWithEof)


        CalculateNullableAndFirst()

        Dim startItem = New LR1Item(m_rootSymbolWithEof.Productions(0).Index, 0, Any.Index)


        'initalize T and E
        m_transitionTable = New LR1TransitionTable
        Dim initStateIndex = m_transitionTable.AddOrFind(CreateState(startItem))

        Dim lastTransitionCount As Integer

        Do
            lastTransitionCount = m_transitionTable.Count

            For Each row In m_transitionTable.ToArray
                For Each item In row.StateReference.Items

                    Dim itemInfo As New LR1ItemInfo(Me, item)
                    If itemInfo.IsPassed Then
                        'It should be a reduce item
                        Continue For
                    End If

                    Dim currentSymbol = itemInfo.GetCurrentSymbol()
                    If TypeOf currentSymbol Is EndOfFile Then
                        'Generate an transition to accept
                        'don't calculate GOTO set
                        row.Transitions.Add(New LR1Transition(row.Index, LR1TransitionTable.AcceptStateIndex, currentSymbol))
                    Else
                        'check if it is a new state
                        Dim newState = GotoSymbol(row.StateReference, currentSymbol)
                        Dim newIndex = m_transitionTable.AddOrFind(newState)

                        'add new transition to the state
                        Dim newTransition As New LR1Transition(row.Index, newIndex, currentSymbol)
                        If Not row.Transitions.Contains(newTransition) Then
                            row.Transitions.Add(newTransition)
                        End If
                    End If
                Next
            Next

        Loop Until lastTransitionCount = m_transitionTable.Count
    End Sub

    Private Sub CalculateReduce()
        If m_transitionTable Is Nothing Then Exit Sub

        For Each row In m_transitionTable
            For Each item In row.StateReference.Items
                Dim itemInfo As New LR1ItemInfo(Me, item)

                If itemInfo.IsPassed Then
                    row.Reduces.Add(New Reduce(itemInfo.LookAhead, itemInfo.Production))
                End If
            Next
        Next
    End Sub

    Public Sub GenerateTransitionTable()
        If m_transitionTable Is Nothing Then
            CalculateStatesAndTransitions()
            CalculateReduce()
        End If
    End Sub

    Public Function IdentifyActions() As List(Of LR1Conflict)
        If m_transitionTable Is Nothing Then Return Nothing

        Dim conflicts As New List(Of LR1Conflict)

        Dim conflictChecker As Dictionary(Of ProductionSymbol, ILR1Action)
        'check shift-shift conflicts and shift-reduce conflicts
        For Each row In m_transitionTable
            conflictChecker = New Dictionary(Of ProductionSymbol, ILR1Action)(17)

            'check transitions
            For Each transition In row.Transitions
                Dim currentAction As ILR1Action

                If TypeOf transition.ConditionSymbol Is Terminal Then
                    currentAction = New LR1Shift(transition.TransitionID, TryCast(transition.ConditionSymbol, Terminal))
                    row.Shifts.Add(TryCast(currentAction, LR1Shift))
                Else
                    'non-terminal
                    currentAction = New LR1Goto(transition.TransitionID, TryCast(transition.ConditionSymbol, NonTerminal))
                    row.Gotos.Add(TryCast(currentAction, LR1Goto))
                End If

                If conflictChecker.ContainsKey(transition.ConditionSymbol) Then
                    'found transition conflict
                    conflicts.Add(New LR1Conflict(row, conflictChecker(transition.ConditionSymbol), currentAction))
                Else
                    conflictChecker.Add(transition.ConditionSymbol, currentAction)
                End If
            Next

            'check reduces
            For Each r In row.Reduces
                If conflictChecker.ContainsKey(r.LookAhead) Then
                    'found reduce conflict
                    conflicts.Add(New LR1Conflict(row, conflictChecker(r.LookAhead), r))

                Else
                    conflictChecker.Add(r.LookAhead, r)
                End If
            Next

            row.SetActions(conflictChecker)
        Next

        'return all conflicts
        Return conflicts
    End Function

    Public Function CalculateParserContext() As List(Of KeyValuePair(Of Integer, String))
        'calculate Transition row source id
        'calculate terminal context

        Dim result As New List(Of KeyValuePair(Of Integer, String))

        For Each row In m_transitionTable
            'find all shift and reduce look ahead terminals

            Dim stateLookAheads As New HashSet(Of Terminal)

            For Each shift In row.Shifts
                stateLookAheads.Add(shift.LookAhead)
            Next

            For Each r In row.Reduces
                stateLookAheads.Add(r.LookAhead)
            Next

            'if no look aheads
            If stateLookAheads.Count = 0 Then Continue For

            'update context info to each terminal
            For Each t In stateLookAheads
                t.AppearedStateIndexes.Add(row.Index)
            Next

            ''check if all the terminals have the same source ID
            'Dim sourceID As Integer = stateLookAheads(0).SourceID

            'For i = 1 To stateLookAheads.Count - 1
            '    If sourceID <> stateLookAheads(i).SourceID Then
            '        'inconsist source id found
            '        'log error and continue next state

            '        result.Add(New KeyValuePair(Of Integer, String)(row.Index, "This row has multiple SourceID"))
            '        row.SourceID = -1

            '        Exit For
            '    End If

            '    'update terminal's state info
            '    stateLookAheads(i).AppearedStateIndexes.Add(row.Index)
            'Next

            'If row.SourceID = -1 Then Continue For

            ''check passed
            'row.SourceID = sourceID

        Next

        Return result
    End Function
End Class
